require(data.table)
Loading required package: data.table Warning message: "package 'data.table' was built under R version 3.6.2"
Setting a seed to have reproducible results
set.seed(95)
Defining a function that produces 1000 uniform random variables between -1 and 1, will be used in Q1
get_dim <- function(){return(runif(1000, min = -1, max = 1))}
As asked in question 1, 15 datasets of dimensions from 1 to 15 are created all having 1000 instances filled with unfiorm random variables from 1 to 1
d1 = data.table(replicate(1, get_dim()))
d2 = data.table(replicate(2, get_dim()))
d3 = data.table(replicate(3, get_dim()))
d4 = data.table(replicate(4, get_dim()))
d5 = data.table(replicate(5, get_dim()))
d6 = data.table(replicate(6, get_dim()))
d7 = data.table(replicate(7, get_dim()))
d8 = data.table(replicate(8, get_dim()))
d9 = data.table(replicate(9, get_dim()))
d10 = data.table(replicate(10, get_dim()))
d11 = data.table(replicate(11, get_dim()))
d12 = data.table(replicate(12, get_dim()))
d13 = data.table(replicate(13, get_dim()))
d14 = data.table(replicate(14, get_dim()))
d15 = data.table(replicate(15, get_dim()))
myfun <- function(x){return(x^2)}
d1[, d_o:= sqrt(rowSums(sapply(d1[,c(1)], myfun)))]
d2[, d_o:= sqrt(rowSums(sapply(d2[,c(1,2)], myfun)))]
d3[, d_o:= sqrt(rowSums(sapply(d3[,c(1:3)], myfun)))]
d4[, d_o:= sqrt(rowSums(sapply(d4[,c(1:4)], myfun)))]
d5[, d_o:= sqrt(rowSums(sapply(d5[,c(1:5)], myfun)))]
d6[, d_o:= sqrt(rowSums(sapply(d6[,c(1:6)], myfun)))]
d7[, d_o:= sqrt(rowSums(sapply(d7[,c(1:7)], myfun)))]
d8[, d_o:= sqrt(rowSums(sapply(d8[,c(1:8)], myfun)))]
d9[, d_o:= sqrt(rowSums(sapply(d9[,c(1:9)], myfun)))]
d10[, d_o:= sqrt(rowSums(sapply(d10[,c(1:10)], myfun)))]
d11[, d_o:= sqrt(rowSums(sapply(d11[,c(1:11)], myfun)))]
d12[, d_o:= sqrt(rowSums(sapply(d12[,c(1:12)], myfun)))]
d13[, d_o:= sqrt(rowSums(sapply(d13[,c(1:13)], myfun)))]
d14[, d_o:= sqrt(rowSums(sapply(d14[,c(1:14)], myfun)))]
d15[, d_o:= sqrt(rowSums(sapply(d15[,c(1:15)], myfun)))]
fractions <- list(
sum(d1[,d_o<=1]) / nrow(d1),
sum(d2[,d_o<=1]) / nrow(d2),
sum(d3[,d_o<=1]) / nrow(d3),
sum(d4[,d_o<=1]) / nrow(d4),
sum(d5[,d_o<=1]) / nrow(d5),
sum(d6[,d_o<=1]) / nrow(d6),
sum(d7[,d_o<=1]) / nrow(d7),
sum(d8[,d_o<=1]) / nrow(d8),
sum(d9[,d_o<=1]) / nrow(d9),
sum(d10[,d_o<=1]) / nrow(d10),
sum(d11[,d_o<=1]) / nrow(d11),
sum(d12[,d_o<=1]) / nrow(d12),
sum(d13[,d_o<=1]) / nrow(d13),
sum(d14[,d_o<=1]) / nrow(d14),
sum(d15[,d_o<=1]) / nrow(d15)
)
frac <- data.table(dimension=c(1:15), fraction=fractions)
plot(frac)
Here we are asked to approximate pi using 2D & 3D fractions
For 2D, Area of the circle = (pi) r r ; we have r=1, thus area = pi
area = as.numeric(frac[frac$dimension==2]$fraction) * 4
volume = as.numeric(frac[frac$dimension==3]$fraction) * 8
area
volume*3/4
myfun <- function(x){return(x^2)}
get_pi <- function(dim, size){
pi = 0
df = data.table(replicate(dim, runif(size, min = -1, max = 1)))
df[, d_o:= sqrt(rowSums(sapply(df, myfun)))]
fr = sum(df[,d_o<=1]) / nrow(df)
if(dim==2){pi = fr*4}
if(dim==3){pi = fr*8*3/4}
return(pi)
}
d2_pi_values = c(get_pi(2,5000),
get_pi(2,10000),
get_pi(2,25000),
get_pi(2,50000),
get_pi(2,100000))
d2_pi = data.table(sample_size=c(5000, 10000, 25000, 50000, 100000), pi = d2_pi_values)
plot(d2_pi)
d3_pi_values = c(get_pi(3,5000),
get_pi(3,10000),
get_pi(3,25000),
get_pi(3,50000),
get_pi(3,100000))
d3_pi = data.table(sample_size=c(5000, 10000, 25000, 50000, 100000), pi = d3_pi_values)
plot(d3_pi)
neighbor <- function(dim){
df = data.table(replicate(dim, runif(1100, min = -1, max = 1)))
d = dist(df, method = "euclidean")
distances = as.matrix(d)[1:1000,1001:1100]
closest_distance <- apply(distances,2,min)
avg = mean(closest_distance)
return(avg)
}
nn = c()
for(d in 1:15){
nn <- c(nn, neighbor(d))
}
nn_dt = data.table(dim=c(1:15), average_min_distance=nn)
plot(nn_dt)
require(jpeg)
Loading required package: jpeg
picture <- readJPEG("picture.jpg")
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(picture, 100, 300, 250, 450)
str(picture)
num [1:512, 1:512, 1:3] 0.522 0.529 0.537 0.529 0.502 ...
picture[1,1:10,]
| 0.5215686 | 0.4941176 | 0.4549020 |
| 0.5254902 | 0.4980392 | 0.4588235 |
| 0.5254902 | 0.4980392 | 0.4666667 |
| 0.5098039 | 0.4823529 | 0.4509804 |
| 0.4862745 | 0.4588235 | 0.4352941 |
| 0.4666667 | 0.4392157 | 0.4156863 |
| 0.4588235 | 0.4313725 | 0.4078431 |
| 0.4588235 | 0.4313725 | 0.4078431 |
| 0.4509804 | 0.4156863 | 0.4196078 |
| 0.4470588 | 0.4156863 | 0.4078431 |
picture[1:10,1:10,2]
| 0.4941176 | 0.4980392 | 0.4980392 | 0.4823529 | 0.4588235 | 0.4392157 | 0.4313725 | 0.4313725 | 0.4156863 | 0.4156863 |
| 0.5019608 | 0.4901961 | 0.4823529 | 0.4784314 | 0.4666667 | 0.4549020 | 0.4431373 | 0.4274510 | 0.4235294 | 0.4117647 |
| 0.4980392 | 0.4823529 | 0.4823529 | 0.4745098 | 0.4470588 | 0.4274510 | 0.4235294 | 0.4117647 | 0.4235294 | 0.4117647 |
| 0.4862745 | 0.4784314 | 0.4745098 | 0.4705882 | 0.4509804 | 0.4392157 | 0.4392157 | 0.4392157 | 0.4117647 | 0.4117647 |
| 0.4627451 | 0.4784314 | 0.4823529 | 0.4666667 | 0.4549020 | 0.4313725 | 0.4117647 | 0.4078431 | 0.4352941 | 0.4235294 |
| 0.3254902 | 0.4509804 | 0.5254902 | 0.5333333 | 0.5294118 | 0.5176471 | 0.5294118 | 0.5803922 | 0.5921569 | 0.5490196 |
| 0.2392157 | 0.4392157 | 0.5450980 | 0.5450980 | 0.5450980 | 0.5333333 | 0.5568627 | 0.6470588 | 0.6549020 | 0.6000000 |
| 0.2431373 | 0.4392157 | 0.5254902 | 0.5137255 | 0.5450980 | 0.5411765 | 0.5450980 | 0.6156863 | 0.6509804 | 0.6039216 |
| 0.2705882 | 0.4431373 | 0.5411765 | 0.5333333 | 0.5294118 | 0.5176471 | 0.5333333 | 0.6000000 | 0.6352941 | 0.5960784 |
| 0.2549020 | 0.4274510 | 0.5294118 | 0.5333333 | 0.5333333 | 0.5333333 | 0.5490196 | 0.6196078 | 0.6549020 | 0.6039216 |
picture_1 = picture[,,1]
picture_2 = picture[,,2]
picture_3 = picture[,,3]
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(picture_1, 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(picture_2, 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(picture_3, 100, 300, 250, 450)
These look like slighly different greyscale pictures.
str(picture_1)
num [1:512, 1:512] 0.522 0.529 0.537 0.529 0.502 ...
plot(colMeans(picture_1), col="red", type="line", xlab="row number", ylab="average")
lines(colMeans(picture_2), col="green")
lines(colMeans(picture_3), col="blue")
Warning message in plot.xy(xy, type, ...): "plot type 'line' will be truncated to first character"
I am wearing pink and the guy behind me is wearing red, the first channel may be related with red color actually.
new_picture <- picture
new_picture[,1:256,1] <- new_picture[,1:256,1] - new_picture[,257:512,1]
new_picture[,1:256,2] <- new_picture[,1:256,2] - new_picture[,257:512,2]
new_picture[,1:256,3] <- new_picture[,1:256,3] - new_picture[,257:512,3]
new_picture[new_picture<0] <- 0
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(new_picture, 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(new_picture[,,1], 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(new_picture[,,2], 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(new_picture[,,3], 100, 300, 250, 450)
max(picture)
noisy <- picture
noisy[,,1] <- noisy[,,1] + replicate(512, runif(512, min = 0, max = 0.1))
noisy[,,2] <- noisy[,,2] + replicate(512, runif(512, min = 0, max = 0.1))
noisy[,,3] <- noisy[,,3] + replicate(512, runif(512, min = 0, max = 0.1))
Reduce to 1 if the value exceeds 1
noisy[noisy>1] <- 1
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(noisy, 100, 300, 250, 450)
Here the noise is barely noticable, I, by mistake, set max value of the random var. to 1, it was way noisy, I added it to the bottom, as well.
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(noisy[,,1], 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(noisy[,,2], 100, 300, 250, 450)
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(noisy[,,3], 100, 300, 250, 450)
noisy2 <- picture
noisy2[,,1] <- noisy2[,,1] + replicate(512, runif(512, min = 0, max = 1))
noisy2[,,2] <- noisy2[,,2] + replicate(512, runif(512, min = 0, max = 1))
noisy2[,,3] <- noisy2[,,3] + replicate(512, runif(512, min = 0, max = 1))
noisy2[noisy2>1] <- 1
plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
rasterImage(noisy2, 100, 300, 250, 450)